home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 3 / BBS in a box - Trilogy III.iso / Files / Util / Md-Mz / Momentum / Momentum.p < prev    next >
Encoding:
Text File  |  1992-06-16  |  17.0 KB  |  596 lines  |  [TEXT/MPS ]
  1. {------------------------------------------------------------------------------
  2. #
  3. #    Momentum CDEV/INIT
  4. #
  5. #    Momentum.p   -   Pascal Source
  6. #
  7. #    Versions:
  8. #
  9. #    Components:
  10. #                
  11. #                
  12. ------------------------------------------------------------------------------}
  13.  
  14.  
  15. {$S TossManager }
  16.  
  17.  
  18. UNIT TossManager;
  19.  
  20.  
  21. INTERFACE
  22.  
  23.  
  24. USES
  25.         MemTypes, QuickDraw, OSIntf, ToolIntf, SANE, PackIntf, MacPrint, Sound, Traps, GestaltEqu;
  26.  
  27. CONST
  28.     { indices for 'TossFlags' }
  29.     OnOffFlag        = 1;            { if 'OnOffFlag' <> 0, then Mo is ON }
  30.     abortFlag        = 2;
  31.     SloMoFlag        = 3;
  32.     SuperSloMo    = 4;
  33.     kGetPtrGestaltSelector    = 'gPtr';
  34.     kGestaltCodeRsrcType    = 'gCOD';
  35.     kGestaltCodeRsrcID        = 128;
  36.  
  37. TYPE
  38.     LongPt = record
  39.         v:    longint;
  40.         h: longint;
  41.     end;
  42.     
  43.     LongRect = record
  44.         top    : longint;
  45.         left    : longint;
  46.         bottom    : longint;
  47.         right    : longint;
  48.     end;
  49.         
  50.     TossParamBlk = record
  51.         DeskFrictn    : integer;                        { first 5 fields are settings from the CDEV }
  52.         BouncFrictn    : integer; 
  53.         GravForce    : integer;
  54.         ClockDir        : integer;
  55.         GravVector    : point;                            { this value is calculated from force & direction }
  56.         Running            : boolean;
  57.         OnlyInFinder        : boolean;
  58.         MakeSound        : integer;                    { if zero, don’t do sounds! }
  59.         SndResNum        : integer;
  60.         SndChannel        : SndChannelPtr;
  61.         TossVelocityV    : longint;                    { pixels/tick*256, calculated on the fly }
  62.         TossVelocityH    : longint;                    { pixels/tick*256, calculated on the fly }
  63.         RegionLoc            : point;                        { region location point }
  64.         ElapsedTicks        : longint;                    { calculated on the fly }
  65.         LongPosition        : LongPt;
  66.         NoMoveCycles    : integer;
  67.         LastSoundTime    : longint;
  68.         MedGraySmoke    : Pattern;
  69.         LtGraySmoke    : Pattern;
  70.         end;
  71.     TossParamPtr    = ^TossParamBlk;
  72.  
  73. {    Units for the param blk:
  74.         DeskFrictn  -     1-100
  75.         BouncFrictn  -     1-100
  76.         GravForce  -     0-100
  77.         GravDirectn  -     vector containing gravity direction w/out magnitude
  78.         GravVector  -     pixels/tick (point w/ hor & ver components) to sum with the current velocity.    }
  79.         
  80.     ScratchParamBlk = record
  81.         PatchPtr            : procPtr;
  82.         OrigActionProc    : procPtr;
  83.         LastMouseLoc    : point;
  84.         PrevMouseLoc    : point;
  85.         LastTime            : longint;
  86.         PrevTime            : longint;
  87.         KeyMapArea        : KeyMap;
  88.         theWorld            : rect;
  89.         ZeroPotential    : integer;
  90.         end;
  91.     ScratchParamPtr    = ^ScratchParamBlk;
  92.  
  93. PROCEDURE PreMo(ScratchPtr    : ScratchParamPtr;
  94.                                 TossParms    : TossParamPtr);
  95. PROCEDURE PostMo(ScratchPtr    : ScratchParamPtr;
  96.                                 TossParms    : TossParamPtr);
  97. FUNCTION TestMo(ScratchPtr    : ScratchParamPtr;
  98.                             TossParms    : TossParamPtr):boolean;
  99. FUNCTION IsMoEnabled(TossParms    : TossParamPtr):boolean;    { checked only once, at the beginning }
  100. PROCEDURE NewMOPosition (TossParams: TossParamPtr; BoundingRect: Rect);
  101. PROCEDURE InstallGestaltPtrReference (DataPtr: ptr);
  102. FUNCTION TossGrayRgn (theRgn        : RgnHandle; 
  103.                                       dragResult    : Point;
  104.                                       startPt        : Point;
  105.                                       limitRect    : Rect; 
  106.                                       slopRect        : Rect; 
  107.                                       axis            : INTEGER; 
  108.                                       ScratchPtr    : ScratchParamPtr;
  109.                                       TossParms    : TossParamPtr): Point;
  110.  
  111.  
  112. IMPLEMENTATION
  113.  
  114. FUNCTION GetMouseAbort (var abortLoc: point): boolean;
  115.     VAR
  116.         theEvent: EventRecord;
  117. BEGIN
  118. {    if EventAvail (mDownMask, theEvent) then
  119.         begin
  120.             GetMouseAbort := TRUE;
  121.             abortLoc := theEvent.where;
  122.             FlushEvents(mouseDown+mouseUp, 0);
  123.         end
  124.     else                        Doesn’t work!    }
  125.         GetMouseAbort := FALSE;
  126. END;
  127.  
  128. FUNCTION MAX(a, b: real): real;
  129. BEGIN
  130.     if a>b then
  131.         MAX := a
  132.     else
  133.         MAX := b;
  134. END;
  135.  
  136. FUNCTION PtInLongRect (thePt: LongPt; aRect: LongRect): boolean;
  137. BEGIN
  138.     with thePt, aRect do
  139.         PtInLongRect := ((v>=top)&(v<=bottom)) & ((h>=left)&(h<=right));
  140. END;
  141.  
  142. PROCEDURE SetLongPt(VAR thePoint: LongPt; horiz, vert: longint);
  143. BEGIN
  144.     thePoint.h := horiz;
  145.     thePoint.v := vert;
  146. END;
  147.  
  148. PROCEDURE AllocateSndChannel(TossParms: TossParamPtr);
  149. VAR    anErr: OSErr;
  150. BEGIN
  151.     with TossParms^ do
  152.     begin
  153.         anErr := SndNewChannel(SndChannel, sampledSynth, 0, nil);
  154.     end;
  155. END;
  156.  
  157. PROCEDURE PlayBounceSound(TossParams: TossParamPtr);
  158. CONST    kTightSndInterval = 7;
  159. VAR    anErr:                 OSErr;
  160.         theSound:         handle;
  161.         currentTime:    longint;
  162. BEGIN
  163.     with TossParams^ do
  164.     begin
  165.         currentTime := TickCount;
  166.         if (currentTime - LastSoundTime) > kTightSndInterval then    { this avoids “machine-gun” ticks }
  167.         begin
  168.             LastSoundTime := currentTime;
  169.             theSound := GetResource('snd ', SndResNum);
  170.             if theSound <> nil then
  171.             begin
  172.                 anErr := SndPlay(SndChannel, theSound, true);
  173.             end;
  174.         end;
  175.     end;
  176. END;
  177.  
  178. PROCEDURE NewMOPosition (TossParams: TossParamPtr; BoundingRect: Rect);
  179. {    Units:    velocity  -    pixels/tick * 256  (point w/ hor & ver components, multiply to add precision)
  180.                 location  -     quickDraw coordinates (global)        }
  181. VAR
  182.     inBounds        : boolean;
  183.     counter            : integer;
  184.     VadjVelocity    : longint;
  185.     HadjVelocity    : longint;
  186.     ProjectedPt    : LongPt;
  187.     originalPt        : LongPt;
  188.     encloseRect    : LongRect;
  189.     frictionDegrade: real;
  190.     speedFactor:                longint;
  191.  
  192.             PROCEDURE BounceOnce (VAR OriginalPoint, ProjectedPoint: LongPt; 
  193.                                                   VAR HzVelocity, VtVelocity: longint;
  194.                                                             BounceRect: LongRect);
  195.             {    'Reflect' the projected point back off of the wall of 'BounceRect' that it intersects.    }
  196.             {    Intersection with the rect is returned in 'OriginalPoint', new pt in 'ProjectedPoint'.    }
  197.             {    Note that the point returned in 'ProjectedPoint' may still be outside of 'BounceRect'.    }
  198.             VAR    rise, run, intersect:    longint;
  199.                     bounceDegrade:            real;
  200.                     soundHdl:                    handle;
  201.                     theErr:                        OSErr;
  202.                     FUNCTION TopBounce: boolean;
  203.                     BEGIN
  204.                         TopBounce := false;
  205.                         if rise = 0 then
  206.                             EXIT(TopBounce);
  207.                         with BounceRect, OriginalPoint do
  208.                         if ProjectedPoint.v <= top then                                { do we project above the top? }
  209.                         begin
  210.                             intersect := h + ((top - v)*run) DIV rise;            { where do we intersect the top? }
  211.                             if (intersect >= left) | (intersect <= right) then    { is it within the BoundsRect? }
  212.                             begin
  213.                                 SetLongPt(OriginalPoint, intersect, top);                { if so, bounce it off the top! }
  214.                                 ProjectedPoint.v := top + (top - ProjectedPoint.v);
  215.                                 VtVelocity := -VtVelocity;
  216.                                 TopBounce := true;
  217.                             end;
  218.                         end;
  219.                     END;
  220.  
  221.                     FUNCTION LeftBounce: boolean;
  222.                     BEGIN
  223.                         LeftBounce := false;
  224.                         if run = 0 then
  225.                             EXIT(LeftBounce);
  226.                         with BounceRect, OriginalPoint do
  227.                         if ProjectedPoint.h <= left then                                { do we project across the left side? }
  228.                         begin
  229.                             intersect := v + ((left - h)*rise) DIV run;            { where do we intersect the left? }
  230.                             if (intersect >= top) | (intersect <= bottom) then    { is it within the BoundsRect? }
  231.                             begin
  232.                                 SetLongPt(OriginalPoint, left, intersect);                { if so, bounce it off the left side! }
  233.                                 ProjectedPoint.h := left + (left - ProjectedPoint.h);
  234.                                 HzVelocity := -HzVelocity;
  235.                                 LeftBounce := true;
  236.                             end;
  237.                         end;
  238.                     END;
  239.                     
  240.                     FUNCTION BottomBounce: boolean;
  241.                     BEGIN
  242.                         BottomBounce := false;
  243.                         if rise = 0 then
  244.                             EXIT(BottomBounce);
  245.                         with BounceRect, OriginalPoint do
  246.                         if ProjectedPoint.v >= bottom then                                { do we project below the bottom? }
  247.                         begin
  248.                             intersect := h + ((bottom - v)*run) DIV rise;            { where do we intersect the bottom? }
  249.                             if (intersect >= left) | (intersect <= right) then    { is it within the BoundsRect? }
  250.                             begin
  251.                                 SetLongPt(OriginalPoint, intersect, bottom);                { if so, bounce it off the bottom! }
  252.                                 ProjectedPoint.v := bottom + (bottom - ProjectedPoint.v);
  253.                                 VtVelocity := -VtVelocity;
  254.                                 BottomBounce := true;
  255.                             end;
  256.                         end;
  257.                     END;
  258.  
  259.                     FUNCTION RightBounce: boolean;
  260.                     BEGIN
  261.                         RightBounce := false;
  262.                         if run = 0 then
  263.                             EXIT(RightBounce);
  264.                         with BounceRect, OriginalPoint do
  265.                         if ProjectedPoint.h >= right then                                { do we project across the right side? }
  266.                         begin
  267.                             intersect := v + ((right - h)*rise) DIV run;            { where do we intersect the right? }
  268.                             if (intersect >= top) | (intersect <= bottom) then    { is it within the BoundsRect? }
  269.                             begin
  270.                                 SetLongPt(OriginalPoint, right, intersect);                { if so, bounce it off the right side! }
  271.                                 ProjectedPoint.h := right + (right - ProjectedPoint.h);
  272.                                 HzVelocity := -HzVelocity;
  273.                                 RightBounce := true;
  274.                             end;
  275.                         end;
  276.                     END;
  277.                     
  278.             BEGIN
  279.                 with TossParams^ do
  280.                 begin
  281.                     rise := ProjectedPoint.v - OriginalPoint.v;
  282.                     run := ProjectedPoint.h - OriginalPoint.h;
  283.                     if NOT BottomBounce then    { possibly bounces off bottom }
  284.                         if NOT LeftBounce then    { possibly bounces off left }
  285.                             if NOT RightBounce then    { possibly bounces off right }
  286.                                 if NOT TopBounce then    { possibly bounces off top }
  287.                                     EXIT(BounceOnce);
  288.                     if MakeSound <> 0 then PlayBounceSound(TossParams);
  289.                     speedFactor := ABS(HzVelocity) + ABS(VtVelocity);
  290.                     bounceDegrade := 0.99 - BouncFrictn/200;
  291.                     if (speedFactor < 500) then
  292.                         bounceDegrade := bounceDegrade*(speedFactor/500);
  293.                     HzVelocity := TRUNC(HzVelocity * bounceDegrade);
  294.                     VtVelocity := TRUNC(VtVelocity * bounceDegrade);
  295.                 end;
  296.             END;
  297.  
  298.  
  299. BEGIN
  300.     with TossParams^ do begin
  301.         encloseRect.top := BoundingRect.top;
  302.         encloseRect.top := encloseRect.top * 256;
  303.         encloseRect.left := BoundingRect.left;
  304.         encloseRect.left := encloseRect.left * 256;
  305.         encloseRect.bottom := BoundingRect.bottom;
  306.         encloseRect.bottom := encloseRect.bottom * 256;
  307.         encloseRect.right := BoundingRect.right;
  308.         encloseRect.right := encloseRect.right * 256;
  309.         frictionDegrade := (0.995 - DeskFrictn/4000)**ElapsedTicks;         { from 0 to 1 }
  310.         HadjVelocity := ROUND((TossVelocityH*frictionDegrade + GravVector.h*ElapsedTicks));
  311.         VadjVelocity := ROUND((TossVelocityV*frictionDegrade + GravVector.v*ElapsedTicks));
  312.  
  313.         ProjectedPt.h := LongPosition.h + HadjVelocity;
  314.         ProjectedPt.v := LongPosition.v + VadjVelocity;
  315.     
  316.         IF (NOT PtInLongRect (ProjectedPt, encloseRect)) THEN begin
  317.             counter := 0;
  318.             originalPt := LongPosition;
  319.             REPEAT
  320.                 counter := counter + 1;
  321.                 BounceOnce (originalPt, ProjectedPt, HadjVelocity, VadjVelocity, encloseRect);
  322.                 inBounds := PtInLongRect (ProjectedPt, encloseRect);
  323.             UNTIL (inBounds OR (counter > 10));
  324.             end;
  325.         TossVelocityH := HadjVelocity;
  326.         TossVelocityV := VadjVelocity;
  327.         LongPosition := ProjectedPt;
  328.         RegionLoc.h := ProjectedPt.h DIV 256;
  329.         RegionLoc.v := ProjectedPt.v DIV 256;
  330.     end;    { with }
  331. END;
  332.  
  333. PROCEDURE PreMo(ScratchPtr    : ScratchParamPtr;
  334.                                 TossParms    : TossParamPtr);
  335. BEGIN
  336.     with TossParms^, ScratchPtr^ do
  337.     begin
  338.         { use last - prev to calculate the velocities }
  339.         elapsedTicks := ROUND(MAX(1, LastTime - PrevTime));
  340.         TossVelocityH := LastMouseLoc.h - PrevMouseLoc.h;
  341.         TossVelocityH := ROUND((TossVelocityH*256)/elapsedTicks);
  342.         TossVelocityV := LastMouseLoc.v - PrevMouseLoc.v;
  343.         TossVelocityV := ROUND((TossVelocityV*256)/elapsedTicks);
  344.         LongPosition.h := RegionLoc.h;
  345.         LongPosition.h := LongPosition.h * 256;
  346.         LongPosition.v := RegionLoc.v;
  347.         LongPosition.v := LongPosition.v * 256;
  348.         NoMoveCycles := 0;
  349.         SndChannel := nil;
  350.         LastSoundTime := 0;
  351.     end;
  352. END;
  353.  
  354. PROCEDURE PostMo(ScratchPtr    : ScratchParamPtr;
  355.                                 TossParms    : TossParamPtr);
  356. VAR    anErr: OSErr;
  357. BEGIN
  358.     with TossParms^, ScratchPtr^ do
  359.     begin
  360.         if SndChannel <> nil then
  361.         begin
  362.             anErr := SndDisposeChannel(SndChannel, true);
  363.             SndChannel := nil;
  364.         end;
  365.     end;
  366. END;
  367.  
  368. FUNCTION IsMoEnabled(TossParms    : TossParamPtr):boolean;
  369. { checked only once, at the beginning }
  370. VAR    theAppName:        str255;
  371.         theFinderName:        str255;
  372.         ptr2FndrName,
  373.         ptr2AppName:        ptr;
  374. BEGIN
  375.     with TossParms^ do
  376.     begin
  377.         if Running & OnlyInFinder then
  378.             begin
  379.                 ptr2FndrName := ptr($2E0);
  380.                 ptr2AppName := ptr($910);
  381.                 BlockMove(ptr2FndrName, @theFinderName, 16);                    { get the name of the Finder }
  382.                 BlockMove(ptr2AppName, @theAppName, 32);
  383.                 IsMoEnabled := IUEqualString(theFinderName, theAppName) = 0;
  384.             end
  385.         else
  386.             IsMoEnabled := Running;
  387.     end;
  388. END;
  389.  
  390. FUNCTION TestMo(ScratchPtr    : ScratchParamPtr;
  391.                             TossParms    : TossParamPtr):boolean;
  392. { returns true when it’s time to stop bouncing }
  393. CONST    kStopThreshold    = 20;
  394. TYPE    foo = array[0..7] of integer;            { added so user can stop by hitting (almost) any key }
  395. VAR    where:                    point;
  396. BEGIN
  397.     with ScratchPtr^, TossParms^ do
  398.     begin
  399.         GetKeys(KeyMapArea);
  400. {        if KeyMapArea[1] | GetMouseAbort(where) then }    { check the S key for STOP! }
  401.         if (foo(KeyMapArea)[0]<>0) |
  402.             (foo(KeyMapArea)[1]<>0) |
  403.             (foo(KeyMapArea)[2]<>0) |
  404.             (foo(KeyMapArea)[3]<>0) |
  405.             (foo(KeyMapArea)[4]<>0) |
  406.             (foo(KeyMapArea)[5]<>0) |
  407.             (foo(KeyMapArea)[6]<>0) then     { check (almost) any key for STOP! }
  408.         begin
  409.             TestMo := true;
  410.             EXIT(TestMo);
  411.         end;
  412.  
  413.         if KeyMapArea[$7C] then        { right arrow }
  414.             TossVelocityH := TossVelocityH + 256;
  415.         if KeyMapArea[$7B] then        { left arrow }
  416.             TossVelocityH := TossVelocityH - 256;
  417.         if KeyMapArea[$7D] then        { down arrow }
  418.             TossVelocityV := TossVelocityV + 256;
  419.         if KeyMapArea[$7E] then        { up arrow }
  420.             TossVelocityV := TossVelocityV - 256;
  421.                 
  422.         FlushEvents(keyDownMask+keyUpMask+autoKeyMask, 0);
  423.         TestMo := (NoMoveCycles > kStopThreshold);
  424.     end;
  425. END;
  426.  
  427. FUNCTION TossGrayRgn (theRgn        : RgnHandle; 
  428.                                       dragResult    : Point;
  429.                                       startPt        : Point;
  430.                                       limitRect    : Rect; 
  431.                                       slopRect        : Rect; 
  432.                                       axis            : INTEGER; 
  433.                                       ScratchPtr    : ScratchParamPtr;
  434.                                       TossParms    : TossParamPtr): Point;
  435. {    Tail patch for 'DragGrayRgn'.    }
  436. CONST
  437.     kDesiredDelay    = 2;
  438. VAR
  439.     loop            : integer;
  440.     currentTk    : longint;
  441.     oldPort        : grafPtr;
  442.     saveRgn    : RgnHandle;
  443.     tLocation    : point; 
  444.     lastLoc        : point; 
  445.     bigRect        : rect;
  446.     oldPen        : PenState;
  447.     grayPatrn    : Pattern;
  448.     PauseTicks: longint;
  449.     delH, delV    : integer;
  450.  
  451. BEGIN
  452.     with TossParms^ do begin
  453.         SetPt(RegionLoc, startPt.h + dragResult.h, startPt.v + dragResult.v);
  454.         PreMo(ScratchPtr, TossParms);
  455.         if     (ABS(TossVelocityV) < 257) & (ABS(TossVelocityH) < 257) then    { note 1 pixel/tick = 256 }
  456.         begin
  457.             TossGrayRgn := dragResult;
  458.             PostMo(ScratchPtr, TossParms);
  459.             EXIT(TossGrayRgn);
  460.         end;
  461.     end;
  462.  
  463.     AllocateSndChannel(TossParms);
  464.     GetPort (oldPort);            { set to wMgr port? }
  465.     GetPenState (oldPen);
  466.     saveRgn := NewRgn;
  467.     GetClip (saveRgn);
  468.     SetRect (bigRect, -32000, -32000, 32000, 32000);
  469.     ClipRect (bigRect);
  470.     PenSize (1, 1);
  471.     PenMode (PatXOr);
  472.     GetIndPattern (grayPatrn,0,4);
  473.     PenPat (grayPatrn);    
  474.  
  475.     with TossParms^, ScratchPtr^ do
  476.     begin
  477.         bigRect := theRgn^^.rgnBBox;
  478.         slopRect.top := slopRect.top + RegionLoc.v - bigRect.top;
  479.         slopRect.bottom := slopRect.bottom + RegionLoc.v - bigRect.bottom;
  480.         slopRect.left := slopRect.left + RegionLoc.h - bigRect.left;
  481.         slopRect.right := slopRect.right + RegionLoc.h - bigRect.right;
  482.         theWorld := slopRect;
  483.         loop := 1;
  484.         FrameRgn (theRgn);                { draw it }    
  485.         REPEAT
  486.             loop := loop + 1;
  487.             SetPt(lastLoc, RegionLoc.h, RegionLoc.v);
  488.             PrevTime := LastTime;                                        { update the 'oldest' tick count }
  489.             LastTime := TickCount;
  490.             ElapsedTicks := LastTime - PrevTime;
  491.             NewMOPosition (TossParms, slopRect);
  492.             delH := RegionLoc.h - lastLoc.h;
  493.             delV := RegionLoc.v - lastLoc.v;
  494.             PauseTicks := kDesiredDelay - (TickCount - LastTime);
  495.             if (PauseTicks > 0) then
  496.                 Delay(PauseTicks, currentTk);
  497.             if (delH = 0) & (delV = 0) then
  498.                 begin
  499.                     NoMoveCycles := NoMoveCycles + 1;
  500.                 end
  501.             else
  502.                 begin
  503.                     NoMoveCycles := 0;
  504.                     FrameRgn (theRgn);                        { undraw it @ old position }        
  505.                     OffsetRgn (theRgn, delH, delV);        { move it }
  506.                     FrameRgn (theRgn);                        { draw it @ new position }        
  507.                 end;
  508.         UNTIL TestMo(ScratchPtr, TossParms);
  509.         FrameRgn (theRgn);                        { undraw it for final time }        
  510.         SetPt(tLocation, RegionLoc.h - startPt.h, RegionLoc.v - startPt.v);
  511.         FlushEvents(keyDownMask+keyUpMask+autoKeyMask, 0);
  512.     end;
  513.     
  514.     SetClip (saveRgn);
  515.     SetPort (oldPort);
  516.     SetPenState (oldPen);
  517.     PostMo(ScratchPtr, TossParms);
  518.     TossGrayRgn := tLocation;
  519. END;
  520.  
  521. {######################################################
  522.         Routines that we need to check for availability of Gestalt
  523. ######################################################}
  524.  
  525. FUNCTION NumToolboxTraps: Integer;
  526. begin
  527.     if NGetTrapAddress(_InitGraf, ToolTrap) = NGetTrapAddress($AA6E, ToolTrap) then
  528.         NumToolboxTraps := $200
  529.     else
  530.         NumToolboxTraps := $400;
  531. end;
  532.  
  533.  
  534. FUNCTION GetTrapType (theTrap: Integer): TrapType;
  535.     const
  536.         TrapMask = $0800;
  537. begin
  538.     if (BAND(theTrap, TrapMask) > 0) then
  539.         GetTrapType := ToolTrap
  540.     else
  541.         GetTrapType := OSTrap;
  542. end;
  543.  
  544.  
  545. FUNCTION TrapAvailable (theTrap: Integer): Boolean;
  546.     var
  547.         tType: TrapType;
  548. begin
  549.     tType := GetTrapType(theTrap);
  550.     if tType = ToolTrap then
  551.         begin
  552.             theTrap := BAND(theTrap, $07FF);
  553.             if (theTrap >= NumToolboxTraps) then
  554.                 theTrap := _Unimplemented;
  555.         end;
  556.     TrapAvailable := NGetTrapAddress(theTrap, tType) <> NGetTrapAddress(_Unimplemented, ToolTrap);
  557. end;
  558.  
  559.  
  560. FUNCTION GestaltAvailable: boolean;
  561. CONST
  562.     GestaltTrap    = $A1AD;
  563. BEGIN
  564.     GestaltAvailable := TrapAvailable (GestaltTrap);
  565. END;
  566.  
  567.  
  568.  
  569. {######################################################
  570.         This is the routine you need to call to install the ptr
  571. ######################################################}
  572.  
  573. PROCEDURE InstallGestaltPtrReference (DataPtr: ptr);
  574. { no need to report error, since when we call 'Gestalt' later to get this info it will return an error if we fail here }
  575. VAR
  576.     codeHdl            : handle;
  577. BEGIN
  578.     IF (GestaltAvailable)
  579.     THEN
  580.         begin
  581.             codeHdl := GetResource (kGestaltCodeRsrcType, kGestaltCodeRsrcID);
  582.             IF (codeHdl <> nil)
  583.             THEN
  584.                 begin
  585.                     DetachResource (codeHdl);
  586.                     IF (NewGestalt (kGetPtrGestaltSelector, codeHdl^) = noErr)
  587.                     THEN 
  588.                         BlockMove (@DataPtr, ptr (ord (codeHdl^) + 10), 4);
  589.                 end;
  590.         end;
  591. END;
  592.  
  593.  
  594.  
  595.  
  596. END.    { unit }